home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / emacs / 19.22 / lisp / pascal.el < prev    next >
Lisp/Scheme  |  1993-11-07  |  35KB  |  981 lines
  1. ;;; pascal.el  -  Major mode for editing pascal source in emacs.
  2.  
  3. ;;; Copyright (C) 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Espen Skoglund (espensk@stud.cs.uit.no)
  6. ;; Keywords: languages
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;;; If you want to customize the pascal mode in your startup file, you
  27. ;;; can add these lines to your .emacs file (and remove the ;s at the
  28. ;;; beginning of the line):
  29. ;;;
  30. ;;; ;;; Pascal-mode custumization.
  31. ;;; (autoload 'pascal-mode "pascal-mode" nil t)
  32. ;;; (setq auto-mode-alist (append (list (cons "\\.p$" 'pascal-mode)
  33. ;;;                                     (cons "\\.pas$" 'pascal-mode))
  34. ;;;                       auto-mode-alist))
  35. ;;; (setq pascal-mode-hook '(lambda ()
  36. ;;;                          ;; User specifications
  37. ;;;                          (setq pascal-tab-always-indent t
  38. ;;;                           pascal-auto-newline nil
  39. ;;;                           pascal-auto-endcomments t
  40. ;;;                           pascal-indent-level 3
  41. ;;;                                pascal-continued-expr 1
  42. ;;;                           pascal-label-offset -2
  43. ;;;                           pascal-case-offset 2
  44. ;;;                           pascal-typedecl-indent 10
  45. ;;;                             pascal-vardecl-indent 20)))
  46.  
  47. ;;; USAGE
  48. ;;; =====
  49. ;;; If you have modified your startup file as described above, emacs
  50. ;;; should enter pascal-mode when you load a pascal source into emacs.
  51. ;;; If not, you will have to start pascal-mode manually:
  52. ;;;    M-x load-library pascal-mode
  53. ;;;    M-x pascal-mode
  54. ;;; When you have entered pascal-mode, you may get more info by pressing
  55. ;;; C-h m. You may also get online help describing various functions by:
  56. ;;;   C-h d <Name of function you want described>
  57.  
  58. ;;; KNOWN BUGS / BUGREPORTS
  59. ;;; =======================
  60. ;;; As far as I know, there are no bugs in the current version of this
  61. ;;; package. This may not be true however, since I never use this mode
  62. ;;; myself and therefore would never notice them anyway. But if you DO
  63. ;;; find any bugd, you may submitt them to: espensk@stud.cs.uit.no
  64.  
  65. ;;; LCD Archive Entry:
  66. ;;; pascal-mode|Espen Skoglund|espensk@stud.cs.uit.no|
  67. ;;; Major mode for editing Pascal code|
  68. ;;; 14-Sep-93|$Revision: 1.1 $|~/modes/pascal-mode.el.Z|
  69.  
  70. (defconst pascal-mode-version "1.3"
  71.   "Version of this pascal mode.")
  72.  
  73. (defvar pascal-mode-abbrev-table nil
  74.   "Abbrev table in use in Pascal-mode buffers.")
  75. (define-abbrev-table 'pascal-mode-abbrev-table ())
  76.  
  77. (defvar pascal-mode-map ()
  78.   "Keymap used in Pascal mode.")
  79. (if (null pascal-mode-map)
  80.     (setq pascal-mode-map (make-sparse-keymap)))
  81.  
  82. (define-key pascal-mode-map ";" 'electric-pascal-semi)
  83. (define-key pascal-mode-map "." 'electric-pascal-dot)
  84. (define-key pascal-mode-map ":" 'electric-pascal-colon)
  85. (define-key pascal-mode-map "=" 'electric-pascal-equal)
  86. (define-key pascal-mode-map "\r" 'electric-pascal-terminate-line)
  87. (define-key pascal-mode-map "\t" 'electric-pascal-tab)
  88. (define-key pascal-mode-map "\177" 'backward-delete-char-untabify)
  89. (define-key pascal-mode-map "\C-\M-a" 'pascal-backward-to-beginning-of-function)
  90. (define-key pascal-mode-map "\C-\M-e" 'pascal-forward-to-end-of-function)
  91. (define-key pascal-mode-map "\C-\M-h" 'pascal-mark-function)
  92. (define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block)
  93. (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
  94. (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
  95. (define-key pascal-mode-map "\M-*" 'pascal-star-comment)
  96.  
  97. ;;; A command to change the whole buffer won't be used terribly
  98. ;;; often, so no need for a key binding.
  99. ;;;(define-key pascal-mode-map "\C-c\C-l" 'pascal-downcase-keywords)
  100. ;;;(define-key pascal-mode-map "\C-c\C-u" 'pascal-upcase-keywords)
  101. ;;;(define-key pascal-mode-map "\C-c\C-c" 'pascal-capitalize-keywords)
  102.  
  103. (defvar pascal-keywords '("and" "array" "begin" "case" "const" "div" "do" 
  104. "downto" "else" "end" "file" "for" "function" "goto" "if" "in" "label" "mod" 
  105. "nil" "not" "of" "or" "packed" "procedure" "program" "record" "repeat" "set" 
  106. "then" "to" "type" "until" "var" "while" "with"
  107. ;; The following are not standard in pascal, but widely used.
  108. "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
  109. "writeln"))
  110.  
  111. (defvar pascal-mode-syntax-table nil
  112.   "Syntax table in use in Pascal-mode buffers.")
  113.  
  114. (if pascal-mode-syntax-table
  115.     ()
  116.   (setq pascal-mode-syntax-table (make-syntax-table))
  117.   (modify-syntax-entry ?\\ "\\" pascal-mode-syntax-table)
  118.   (modify-syntax-entry ?( ". 1" pascal-mode-syntax-table)  
  119.   (modify-syntax-entry ?) ". 4" pascal-mode-syntax-table)
  120.   (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table)
  121.   (modify-syntax-entry ?{ "<" pascal-mode-syntax-table)
  122.   (modify-syntax-entry ?} ">" pascal-mode-syntax-table)
  123.   (modify-syntax-entry ?+ "." pascal-mode-syntax-table)
  124.   (modify-syntax-entry ?- "." pascal-mode-syntax-table)
  125.   (modify-syntax-entry ?= "." pascal-mode-syntax-table)
  126.   (modify-syntax-entry ?% "." pascal-mode-syntax-table)
  127.   (modify-syntax-entry ?< "." pascal-mode-syntax-table)
  128.   (modify-syntax-entry ?> "." pascal-mode-syntax-table)
  129.   (modify-syntax-entry ?& "." pascal-mode-syntax-table)
  130.   (modify-syntax-entry ?| "." pascal-mode-syntax-table)
  131.   (modify-syntax-entry ?_ "w" pascal-mode-syntax-table)
  132.   (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table))
  133.  
  134. (defconst pascal-indent-level 3
  135.   "*Indentation of Pascal statements with respect to containing block.")
  136. (defconst pascal-continued-expr 1
  137.   "*Indentation of line that is a continued expression.")
  138. (defconst pascal-label-offset -1
  139.   "*Offset of Pascal label lines, case statements and record lines.
  140. This is relative to usual indentation.")
  141. (defconst pascal-case-offset 2
  142.   "*Indentation after case statements.")
  143. (defconst pascal-vardecl-indent 15
  144.   "*Indentation (from the beginning of line to `:' of the declaration.")
  145. (defconst pascal-typedecl-indent 10
  146.   "*Indentation (from the beginning of line to `=' of the declaration.")
  147. (defconst pascal-auto-newline nil
  148.   "*Non-nil means automatically newline after semicolons and `end'.")
  149. (defconst pascal-tab-always-indent t
  150.   "*Non-nil means TAB in Pascal mode should always reindent the current line.
  151. It does so regardless of where in the line point is
  152. when the TAB command is used.")
  153. (defconst pascal-auto-endcomments t
  154.   "*Non-nil means make a comment { ... } after the end for a case or function.
  155. The name of the function or case is put between the braces.")
  156.  
  157. ;;;###autoload
  158. (defun pascal-mode ()
  159.   "Major mode for editing Pascal code.
  160. Tab indents for Pascal code.
  161. Delete converts tabs to spaces as it moves back.
  162. \\{pascal-mode-map}
  163. Variables controlling indentation style:
  164.  pascal-tab-always-indent (default t)
  165.     Non-nil means TAB in Pascal mode should always reindent the current line,
  166.     regardless of where in the line point is when the TAB command is used.
  167.  pascal-auto-newline (default nil)
  168.     Non-nil means automatically newline after semicolons and the punctation
  169.     mark after an end.
  170.  pascal-auto-endcomments (default t)
  171.     Non-nil means automatically set name of function or `case' in braces after
  172.     after the `end' if this end ends a function or a case block.
  173.  pascal-indent-level (default 3)
  174.     Indentation of Pascal statements within surrounding block.
  175.  pascal-continued-expr (default 1)
  176.     Indentation of a line that is a continued expression.
  177.  pascal-typedecl-indent (default 10)
  178.     Indentation to the `=' in type declarations. (Or constant declarations.)
  179.  pascal-vardecl-indent (default 20)
  180.     Indentation to the `:' in var declarations.
  181.  pascal-label-offset (default -1)
  182.     Extra indentation for line that is a label, case statement or part of
  183.     a record block.
  184.  pascal-case-offset (default 2)
  185.     Extra indent to the `:' in case statements.
  186.  
  187. The only auto indention this mode doesn't fully support is if there is a
  188. case within a type declaration.  However, this is seldom used.
  189.  
  190. When typing text, you should not worry about to get right indentions, they
  191. will be set when you hit return. The mode will also automatically delete the
  192. whitespaces between `*' and `)' when ending a starcomment.
  193.  
  194. Turning on Pascal mode calls the value of the variable pascal-mode-hook with
  195. no args, if that value is non-nil."
  196.   (interactive)
  197.   (kill-all-local-variables)
  198.   (use-local-map pascal-mode-map)
  199.   (setq major-mode 'pascal-mode)
  200.   (setq mode-name "Pascal")
  201.   (setq local-abbrev-table pascal-mode-abbrev-table)
  202.   (set-syntax-table pascal-mode-syntax-table)
  203.   (make-local-variable 'indent-line-function)
  204.   (setq indent-line-function 'pascal-indent-line)
  205.   (setq comment-indent-hook 'pascal-indent-within-comment)
  206.   (make-local-variable 'parse-sexp-ignore-comments)
  207.   (setq parse-sexp-ignore-comments t)
  208.   (make-local-variable 'case-fold-search)
  209.   (setq case-fold-search t)
  210.   (run-hooks 'pascal-mode-hook))
  211.  
  212. ;;;
  213. ;;;  Electric functions
  214. ;;;
  215.  
  216. (defun electric-pascal-terminate-line ()
  217.   "Terminate line and indent next line."
  218.   (interactive)
  219.   (save-excursion
  220.     (beginning-of-line)
  221.     (skip-chars-forward " \t")
  222.     (if (looking-at "until\\b\\|end\\(\\b\\|;\\|\\.\\)\\|begin\\b\\|repeat\\b\\|else\\b")
  223.     (pascal-indent-line)))
  224.   (newline)
  225.   (pascal-indent-line)
  226.   ;; Maybe we should set some endcomments
  227.   (if pascal-auto-endcomments
  228.       (pascal-set-auto-comments))
  229.   ;; Check if we shall indent inside comment
  230.   (let ((setstar nil))
  231.     (save-excursion
  232.       (forward-line -1)
  233.       (skip-chars-forward " \t")
  234.       (cond ((looking-at "\\*[ \t]*)")
  235.          ;; Delete region between `*' and `)' if there is only whitespaces.
  236.          (forward-char 1)
  237.          (pascal-delete-whitespaces))
  238.         ((and (looking-at "(\\*\\|\\*[^)]")
  239.           (not (save-excursion
  240.              (search-forward "*)" (pascal-get-end-of-line) t))))
  241.          (setq setstar t))))
  242.     ;; If last line was a star comment line then this one shall be too.
  243.     (if setstar
  244.     (progn
  245.       (insert "*")
  246.       (pascal-indent-command))
  247.       (pascal-indent-line))))
  248.  
  249. (defun electric-pascal-semi ()
  250.   "Insert ; character and correct this line's indention."
  251.   (interactive)
  252.   (insert last-command-char)
  253.   (save-excursion
  254.     (beginning-of-line)
  255.     (pascal-indent-line))
  256.   (if pascal-auto-newline
  257.       (electric-pascal-terminate-line)))
  258.  
  259. (defun electric-pascal-dot ()
  260.   "Insert a period and correct this line's indention."
  261.   (interactive)
  262.   (insert last-command-char)
  263.   (save-excursion
  264.     (beginning-of-line)
  265.     (pascal-indent-line))
  266.   (if pascal-auto-newline
  267.       (electric-pascal-terminate-line)))
  268.  
  269. (defun electric-pascal-colon ()
  270.   "Insert : and do all indentions except line indent on this line."
  271.   (interactive)
  272.   (insert last-command-char)
  273.   ;; Do nothing of within string.
  274.   (if (not (pascal-within-string))
  275.       (progn
  276.     (if (save-excursion
  277.           (backward-char 2)
  278.           (looking-at "[0-9]"))
  279.         (save-excursion
  280.           (beginning-of-line)
  281.           (pascal-indent-line)))
  282.     (let ((pascal-tab-always-indent nil))
  283.       (pascal-indent-command)))))
  284.   
  285. (defun electric-pascal-equal ()
  286.   "Insert = and do indention if within type declaration."
  287.   (interactive)
  288.   (insert last-command-char)
  289.   (if (eq (nth 1 (pascal-calculate-indent t)) 'decl)
  290.       (let ((pascal-tab-always-indent nil))
  291.     (pascal-indent-command))))
  292.  
  293. (defun electric-pascal-tab ()
  294.   "Function called when tab is pressed."
  295.   (interactive)
  296.   ;; Do nothing if within a string.
  297.   (if (not (pascal-within-string))
  298.       ;; If pascal-tab-always-indent is set then indent the beginning of
  299.       ;; the line.
  300.       (progn
  301.     (if pascal-tab-always-indent
  302.         (save-excursion
  303.           (beginning-of-line)
  304.           (pascal-indent-line)))
  305.     (pascal-indent-command))))
  306.  
  307. ;;;
  308. ;;; Interactive functions
  309. ;;;
  310. (defun pascal-insert-block ()
  311.   "Insert begin ... end; block in the code with right indents."
  312.   (interactive)
  313.   (pascal-indent-line)
  314.   (insert "begin")
  315.   (electric-pascal-terminate-line)
  316.   (save-excursion
  317.     (electric-pascal-terminate-line)
  318.     (insert "end;")
  319.     (beginning-of-line)
  320.     (pascal-indent-line)))
  321.  
  322. (defun pascal-star-comment ()
  323.   "Insert star comment in the code."
  324.   (interactive)
  325.   (pascal-indent-line)
  326.   (insert "(*")
  327.   (electric-pascal-terminate-line)
  328.   (save-excursion
  329.     (electric-pascal-terminate-line)
  330.     (pascal-delete-whitespaces)
  331.     (insert ")")))
  332.  
  333. (defun pascal-mark-function ()
  334.   "Mark the current pascal function (or procedure).
  335. Put the mark at the end of the function, and point at the beginning."
  336.   (interactive)
  337.   (push-mark (point))
  338.   (pascal-forward-to-end-of-function)
  339.   (push-mark (point))
  340.   (pascal-backward-to-beginning-of-function)
  341.   (zmacs-activate-region))
  342.  
  343. (defun pascal-comment-area (start end)
  344.   "Put the current region in a comment.
  345. The comments that are in this area are
  346. be changed so that `*)' becomes `!(*' and `}' becomes `!{'. These will
  347. however be turned back to normal when the area is uncommented by pressing
  348. \\[pascal-uncomment-area].
  349. The commented area starts with: `{---\\/---EXCLUDED---\\/---' , and ends with:
  350. ` ---/\\---EXCLUDED---/\\---}'. If these texts are changed, uncomment-area
  351. will not be able to recognize them."
  352.   (interactive "r")
  353.   (save-excursion
  354.     ;; Insert start and endcomments
  355.     (goto-char end)
  356.     (if (and (save-excursion (skip-chars-forward " \t") (eolp))
  357.          (not (save-excursion (skip-chars-backward " \t") (bolp))))
  358.     (forward-line 1)
  359.       (beginning-of-line))
  360.     (insert " ---/\\---EXCLUDED---/\\---}")
  361.     (setq end (point))
  362.     (newline)
  363.     (goto-char start)
  364.     (beginning-of-line)
  365.     (insert "{---\\/---EXCLUDED---\\/--- ")
  366.     (newline)
  367.     ;; Replace end-comments within commented area
  368.     (goto-char end)
  369.     (save-excursion
  370.       (while (re-search-backward "\\*)" start t)
  371.     (replace-match "!(*" t t)))
  372.     (save-excursion
  373.       (while (re-search-backward "}" start t)
  374.     (replace-match "!{" t t)))))
  375.  
  376. (defun pascal-uncomment-area ()
  377.   "Uncomment a commented area.
  378. Change all deformed comments in this area back to normal.
  379. This function does nothing if the pointer is not in a commented
  380. area.  See also `pascal-comment-area'."
  381.   (interactive)
  382.   (save-excursion
  383.     (let ((start (point))
  384.       (end (point)))
  385.       ;; Find the boundaries of the comment
  386.       (save-excursion
  387.     (setq start (progn (search-backward "{---\\/---EXCLUDED---\\/--" nil t)
  388.                (point)))
  389.     (setq end (progn (search-forward "---/\\---EXCLUDED---/\\---}" nil t)
  390.              (point))))
  391.       ;; Check if we're really inside a comment
  392.       (if (or (equal start (point)) (<= end (point)))
  393.       (message "Not standing within commented area.")
  394.     (progn
  395.       ;; Remove endcomment
  396.       (goto-char end)
  397.       (beginning-of-line)
  398.       (let ((pos (point)))
  399.         (end-of-line)
  400.         (delete-region pos (1+ (point))))
  401.       ;; Change comments back to normal
  402.       (save-excursion
  403.         (while (re-search-backward "!{" start t)
  404.           (replace-match "}" t t)))
  405.       (save-excursion
  406.         (while (re-search-backward "!(\\*" start t)
  407.           (replace-match "*)" t t)))
  408.       ;; Remove startcomment
  409.       (goto-char start)
  410.       (beginning-of-line)
  411.       (let ((pos (point)))
  412.         (end-of-line)
  413.         (delete-region pos (1+ (point)))))))))
  414.  
  415. (defun pascal-backward-to-beginning-of-function ()
  416.   "Move backwards to the beginning of this function or procedure."
  417.   (interactive)
  418.   ;; Check if this is a 
  419.   (if (save-excursion
  420.     (re-search-backward "\\<end" nil t)
  421.     (looking-at "end\\."))
  422.       (beginning-of-buffer)
  423.     (let ((nest-depth 0) (nest-max 0)
  424.       (nest-noexit 1))
  425.       (beginning-of-line)
  426.       ;; First we find the max depth of the nesting
  427.       (save-excursion
  428.     (while (not (or (bobp) (looking-at "function\\b\\|procedure\\b")))
  429.       (backward-sexp 1)
  430.       (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b")
  431.          (setq nest-depth (1+ nest-depth)))
  432.         ((looking-at "end\\(\\b\\|;\\|\\.\\)")
  433.          (setq nest-depth (1- nest-depth))))
  434.       (setq nest-max (max nest-depth nest-max))))
  435.       ;; Then we can start searching
  436.       (setq nest-depth 0)
  437.       (while (not (or (bobp) (and (looking-at "function\\b\\|procedure\\b")
  438.                   (zerop nest-noexit))))
  439.     (backward-sexp 1)
  440.     (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b")
  441.            (setq nest-depth (1+ nest-depth)))
  442.           ((looking-at "end\\(\\b\\|;\\|\\.\\)")
  443.            (if (equal nest-depth nest-max)
  444.            (setq nest-noexit (1+ nest-noexit)))
  445.            (setq nest-depth (1- nest-depth)))
  446.           ((looking-at "function\\b\\|procedure\\b")
  447.            (setq nest-noexit (1- nest-noexit))))))))
  448.  
  449. (defun pascal-forward-to-end-of-function ()
  450.   "Moves the point to the end of the function."
  451.   (interactive)
  452.   (if (not (looking-at "function\\b\\|procedure\\b"))
  453.       (pascal-backward-to-beginning-of-function))
  454.   (if (bobp)
  455.       (end-of-buffer)
  456.     (progn
  457.       (let ((nest-depth 0)
  458.         (func-depth 1))
  459.     (while (not (or (and (zerop nest-depth) (zerop func-depth)) (eobp)))
  460.       (forward-sexp 2)
  461.       (if (not (eobp))
  462.           (progn
  463.         (backward-sexp 1) ; Move to the beginning of the next sexp
  464.         (cond ((looking-at "begin\\b\\|case\\b\\|record\\b")
  465.                (setq nest-depth (1+ nest-depth)))
  466.               ((looking-at "end\\(\\b\\|;\\|\\.\\)")
  467.                (setq nest-depth (1- nest-depth))
  468.                (if (zerop nest-depth)
  469.                (setq func-depth (1- func-depth))))
  470.               ((looking-at "function\\b\\|procedure\\b")
  471.                (setq func-depth (1+ func-depth)))))))
  472.     (end-of-line)))))
  473.  
  474. (defun pascal-downcase-keywords ()
  475.   "Makes all Pascal keywords in the buffer lowercase."
  476.   (interactive)
  477.   (pascal-change-keywords 'downcase-word))
  478.  
  479. (defun pascal-upcase-keywords ()
  480.   "Makes all Pascal keywords in the buffer uppercase."
  481.   (interactive)
  482.   (pascal-change-keywords 'upcase-word))
  483.  
  484. (defun pascal-capitalize-keywords ()
  485.   "Makes all Pascal keywords in the buffer uppercase."
  486.   (interactive)
  487.   (pascal-change-keywords 'capitalize-word))
  488.  
  489. (defun pascal-change-keywords (change-word)
  490.   "Change the keywords according to argument."
  491.   (save-excursion
  492.     (beginning-of-buffer)
  493.     (while (re-search-forward (mapconcat
  494.                    'downcase pascal-keywords "\\>\\|\\<") nil t)
  495.       (funcall change-word -1))))
  496.  
  497. ;;;
  498. ;;; Other functions
  499. ;;;
  500. (defun pascal-delete-whitespaces ()
  501.   "Deletes the whitespaces around the current point."
  502.   (interactive)
  503.   (let ((pos (progn (skip-chars-backward " \t") (point))))
  504.     (skip-chars-forward " \t")
  505.     (delete-region pos (point))))
  506.  
  507. (defun pascal-get-beg-of-line ()
  508.   (save-excursion
  509.     (beginning-of-line)
  510.     (point)))
  511.  
  512. (defun pascal-get-end-of-line ()
  513.   (save-excursion
  514.     (end-of-line)
  515.     (point)))
  516.   
  517. (defun pascal-within-string ()
  518.   "Return t if within string; nil otherwise."
  519.   (and (save-excursion (search-backward "\"" (pascal-get-beg-of-line) t))
  520.        (save-excursion (not (search-backward "\"" (pascal-get-beg-of-line) t 2)))))
  521.  
  522. (defun pascal-check-if-within-comment ()
  523.   "If within a comment, return the correct indent.  Return nil otherwise."
  524.   (let ((comstart (point))
  525.     (comend (point)))
  526.     (save-excursion
  527.       (if (re-search-backward "(\\*\\|{" nil t)
  528.       (setq comstart (point))
  529.     (setq comstart 0)))
  530.     (save-excursion
  531.       (if (re-search-backward "\\*)\\|}" nil t)
  532.       (setq comend (point))
  533.     (setq comend 0)))
  534.     (if (< comend comstart)
  535.     (save-excursion
  536.       (goto-char comstart)
  537.       ;; Add 1 to indent if this is a starcomment
  538.       (if (looking-at "(\\*")
  539.           (1+ (current-column))
  540.         (current-column)))
  541.       nil)))
  542.  
  543. (defun pascal-set-auto-comments ()
  544.   "Put { case } or { FUNNAME } on this line if appropriate after `end'."
  545.   (save-excursion
  546.     (forward-line -1)
  547.     (skip-chars-forward " \t")
  548.     (if (and (looking-at "end\\(\>\\|;\\)")
  549.          (not (save-excursion
  550.             (end-of-line)
  551.             (search-backward "}" (pascal-get-beg-of-line) t))))
  552.     (progn
  553.       (if (eq (nth 1 (pascal-calculate-indent)) 'case)
  554.           ;; This is a case block
  555.           (progn
  556.         (end-of-line)
  557.         (pascal-delete-whitespaces)
  558.         (insert " { case }"))
  559.         (let ((nest 1))
  560.           ;; Check if this is the end of a function
  561.           (save-excursion
  562.         (while (not (or (looking-at "function\\b\\|\\procedure\\b")
  563.                 (bobp)))
  564.           (backward-sexp 1)
  565.           (cond ((looking-at "begin\\b\\|case\\b")
  566.              (setq nest (1- nest)))
  567.             ((looking-at "end\\(\\b\\|;\\|\\.\\)")
  568.              (setq nest (1+ nest)))))
  569.         (if (bobp)
  570.             (setq nest 1)))
  571.           (if (zerop nest)
  572.           (let ((last-command nil))
  573.             ;; Find the function name and put it in braces
  574.             (save-excursion
  575.               (pascal-backward-to-beginning-of-function)
  576.               (skip-chars-forward "^ \t")
  577.               (skip-chars-forward " \t")
  578.               (copy-region-as-kill (point)
  579.                        (save-excursion
  580.                          (skip-chars-forward "a-zA-Z0-9_")
  581.                          (point))))
  582.             (end-of-line)
  583.             (pascal-delete-whitespaces)
  584.             (insert " { ")
  585.             ;; We've filled up the kill ring, but hey, who cares?
  586.             (yank) (rotate-yank-pointer 1)
  587.             (insert " }")))))))))
  588.  
  589. ;;;
  590. ;;; Indent functions and calculation of indent
  591. ;;;    
  592. (defun pascal-indent-command ()
  593.   "Indent current line as Pascal code and/or indent within line."
  594.   ;; Call pascal-indent-line. This does nothing if we're not at the
  595.   ;; beginning of the line.
  596.   (pascal-indent-line)
  597.   (let ((indent (pascal-calculate-indent t))
  598.     (pos 0))
  599.     (save-excursion
  600.       (cond ((or (eq (nth 1 indent) 'case)
  601.          (eq (nth 1 indent) 'record))
  602.          ;; Indent for case and record blocks
  603.          (beginning-of-line)
  604.          (if (search-forward ":" (pascal-get-end-of-line) t)
  605.          (progn
  606.            ;; Indent before colon
  607.            (backward-char 1)
  608.            (pascal-delete-whitespaces)
  609.            (indent-to (max (pascal-find-leading-case-colon)
  610.                    (1+ (current-column))))
  611.            ;; Indent after colon
  612.            (forward-char 1)
  613.            (pascal-delete-whitespaces)
  614.            (indent-to (1+ (current-column))))
  615.            ;; Indent if there is no colon
  616.            (progn
  617.          (beginning-of-line)
  618.          (skip-chars-forward " \t")
  619.          (if (not (eolp))
  620.              (progn
  621.                (skip-chars-forward "0-9a-zA-Z\"\'_;")
  622.                (pascal-delete-whitespaces)
  623.                (indent-to (max (pascal-find-leading-case-colon)
  624.                        (1+ (current-column)))))))))
  625.         ((eq (nth 1 indent) 'decl)
  626.          ;; Indent for declarations
  627.          (let ((posii (pascal-get-beg-of-line)))
  628.            (re-search-backward "\\<\\(var\\|type\\|const\\|label\\)\\>"
  629.                    nil t)
  630.            (cond ((looking-at "var\\b")
  631.               (pascal-declindent-middle-of-line
  632.                ":" posii pascal-vardecl-indent))
  633.              ((looking-at "type\\b\\|const\\b")
  634.               (pascal-declindent-middle-of-line
  635.                "=" posii pascal-typedecl-indent)))))
  636.         ((eq (nth 1 indent) 'function)
  637.          ;; Indent for parameterlist
  638.          ;; Done twice in case something has changed
  639.          (pascal-indent-parameter-list)
  640.          (pascal-indent-parameter-list))))         
  641.     ;; Go to the end of a line if rest of line contains only whitespaces
  642.     (if (save-excursion (skip-chars-forward " \t") (eolp))
  643.     (end-of-line))))
  644.  
  645. (defun pascal-indent-line ()
  646.   "Indent current line as Pascal code."
  647.   (let ((indent (list 0 nil))
  648.     (comindent 0)
  649.     beg (point))
  650.     (save-excursion
  651.       (beginning-of-line)
  652.       (setq indent (pascal-calculate-indent)))
  653.     ;; If we are inside a comment, do special indent.
  654.     (if (setq comindent (pascal-check-if-within-comment))
  655.     (pascal-indent-within-comment comindent)
  656.       ;; Skip the rest if we're not standing on the beginning of a line.
  657.       (if (save-excursion (skip-chars-backward " \t") (bolp))
  658.       (progn
  659.         (beginning-of-line)
  660.         (pascal-delete-whitespaces)
  661.         ;; When to skip the ekstra indent:
  662.         ;; If we are standing at end or until.
  663.         ;; If we are in an if statement and standing at else,
  664.         ;;  begin or repeat
  665.         ;; If we are in a with, while or for statement and standing
  666.         ;;  at begin or end.
  667.         (cond ((or (or (looking-at "end\\b\\|until\\b")
  668.                (not (nth 1 indent)))
  669.                (and (eq (nth 1 indent) 'if)
  670.                 (looking-at "begin\\b\\|\\repeat\\b\\|else\\b"))
  671.                (and (eq (nth 1 indent) 'whilewith)
  672.                 (looking-at "begin\\b\\|\\repeat\\b")))
  673.            (indent-to (car indent)))
  674.           ;; Continued expression
  675.           ((eq (nth 1 indent) 'contexp)
  676.            (indent-to (+ (car indent) pascal-continued-expr)))
  677.           ;; If this is a part of a case or record block,
  678.           ;; then modify the indent level.
  679.           ((or (eq (nth 1 indent) 'case)
  680.                (eq (nth 1 indent) 'record))
  681.            (indent-to (+ (car indent) pascal-indent-level
  682.                  pascal-label-offset)))
  683.           ;; If this is a label - don't indent.
  684.           ((looking-at "[0-9]*:")
  685.            (skip-chars-forward "0-9:")
  686.            (pascal-delete-whitespaces)
  687.            (indent-to (+ (car indent) pascal-indent-level)))
  688.           ;; If this is insde a parameter list, do special indent
  689.           ((eq (nth 1 indent) 'function)
  690.            (pascal-indent-parameter-list))
  691.           ;; All other indents are set normaly.
  692.           (t
  693.            (indent-to (+ (car indent) pascal-indent-level)))))))))
  694.     
  695. (defun pascal-calculate-indent (&optional arg)
  696.   "Search backward in code to find the right indent level.
  697. Return a list containing:
  698. 1. Indent level
  699. 2. The indent keyword (begin, case etc.), or nil if backtracking failed.
  700. If arg is non-nil, we do not search for continued expressions."
  701.   (let ((pascal-nest-depth 1)
  702.     (oldpos (save-excursion (forward-line -1) (end-of-line) (point)))
  703.     (samepos (point)) (if-is-set t)
  704.     (return-struct (list 0 nil)) (pos 0)
  705.     (contexpr nil) (after-contexpr (not arg))
  706.     (case-fold-search t))
  707.     (save-excursion
  708.       (while (and (not (zerop pascal-nest-depth))
  709.           (not (bobp)))
  710.     (progn
  711.       (backward-sexp 1)
  712.       (if (save-excursion
  713.         (setq pos (point))
  714.         (end-of-line)
  715.         (search-backward ";" pos t))
  716.           (setq if-is-set nil
  717.             after-contexpr nil))
  718.       (if (looking-at "then\\b\\|end\\b\\|else\\b\\|do\\b")
  719.           (setq after-contexpr nil))
  720.  
  721.       (cond ((looking-at "begin\\b\\|case\\b\\|record\\b\\|repeat\\b")
  722.          (setq pascal-nest-depth (1- pascal-nest-depth)))
  723.         ;;
  724.         ;; END | UNTIL
  725.         ((looking-at "end\\(\\b\\|;\\|\\.\\)\\|until\\b")
  726.          (setq if-is-set nil)
  727.          (if after-contexpr
  728.              (setq pascal-nest-depth 0
  729.                contexpr t)
  730.            (setq pascal-nest-depth (1+ pascal-nest-depth))))
  731.         ;;
  732.         ;; IF | ELSE | WITH | WHILE | FOR
  733.         ;; LABEL |  CONST | TYPE | FUNCTION | PROCEDURE
  734.         ((or (and (looking-at "if\\b\\|else\\b\\|with\\b\\|while\\b\\|for\\b")
  735.               if-is-set)
  736.              (looking-at "label\\b\\|const\\b\\|type\\b\\|function\\b\\|procedure\\b"))
  737.          (setq pascal-nest-depth 0))
  738.         ;;
  739.         ;; VAR
  740.         ((looking-at "var\\b")
  741.          ;; A `var' can be in a declaration part or parameter part
  742.          (let ((stpos 0) (edpos 0))
  743.            (save-excursion
  744.              (if (not (re-search-backward
  745.                    "\\<\\(function\\|procedure\\)\\>" nil t))
  746.              (beginning-of-buffer))
  747.              (setq stpos (save-excursion
  748.                    (search-forward "(" nil t) (point)))
  749.              (setq edpos (save-excursion
  750.                    (search-forward ")" nil t) (point))))
  751.            (cond ((or (= stpos edpos) (< samepos stpos)
  752.                   (and (> (point) edpos) (> edpos stpos)))
  753.               ;; This is really a declaration block!!
  754.               nil)
  755.              ((and (>= samepos stpos) (or (< samepos edpos)
  756.                               (> stpos edpos)))
  757.               ;; Hmm... part of a parameter
  758.               (re-search-backward
  759.                "\\<\\(function\\|procedure\\)\\>" nil t))
  760.              (t
  761.               ;; This is just after a parameter declaration
  762.               (forward-char 1)))
  763.            ;; We'll quit anyway
  764.            (setq pascal-nest-depth 0)))
  765.         ;;
  766.         ;; CONTINUED EXPRESSIONS
  767.         (after-contexpr
  768.          (save-excursion
  769.            ;; First, we have to be at the begining of a line
  770.            (if (and (progn (skip-chars-backward " \t") (bolp))
  771.                 ;; Blank lines don't count
  772.                 (not (progn (skip-chars-forward " \t") (eolp)))
  773.                 ;; But nonblank without ';' do
  774.                 (not (search-forward ";" (pascal-get-end-of-line) t)))
  775.                (save-excursion
  776.              (forward-line -1)
  777.              (end-of-line)
  778.              (backward-sexp 1)
  779.              (if (or (looking-at "\\(do\\|then\\|of\\\|begin\\|repeat\\|else\\)\\>")
  780.                  (progn
  781.                    (skip-chars-forward "^; " (pascal-get-end-of-line))
  782.                    (equal (char-to-string (following-char))
  783.                       ";")))
  784.                  (setq pascal-nest-depth 0))
  785.              (setq contexpr t)))))
  786.         )))
  787.       (cond (contexpr
  788.          (setq return-struct (list (pascal-lstart-col) 'contexp)))
  789.         ((looking-at "begin\\b")
  790.          (setq return-struct (list (pascal-lstart-col) 'begin)))
  791.         ((looking-at "else\\b")
  792.          (setq return-struct (list (save-excursion
  793.                      (re-search-backward "if\\b" nil t)
  794.                      (pascal-lstart-col)) 'if))
  795.          ;; Indent line in case this is a multiple if
  796.          (beginning-of-line)
  797.          (pascal-delete-whitespaces)
  798.          (indent-to (car return-struct)))
  799.         ((looking-at "if\\b")
  800.          (if (save-excursion
  801.            (narrow-to-region (pascal-get-beg-of-line) (point))
  802.            (backward-sexp 1)
  803.            (widen)
  804.            (looking-at "else\\b"))
  805.          ;; Indent line if this is a multiple if
  806.          (progn
  807.            (beginning-of-line)
  808.            (pascal-delete-whitespaces)
  809.            (indent-to (save-excursion
  810.                 (re-search-backward "if\\b" nil t)
  811.                 (pascal-lstart-col)))))
  812.          ;; This could be a continued expression
  813.          (if (and after-contexpr
  814.               (not (save-excursion (re-search-forward
  815.                         "then\\b" (pascal-get-end-of-line) t))))
  816.          (setq return-struct (list (pascal-lstart-col) 'contexp))
  817.            (setq return-struct (list (pascal-lstart-col) 'if))))
  818.         ((looking-at "repeat\\b")
  819.          (setq return-struct (list (pascal-lstart-col) 'repeat)))
  820.         ((looking-at "case\\b")
  821.          (setq return-struct (list (current-column) 'case)))
  822.         ((looking-at "record\\b")
  823.          (setq return-struct (list (current-column) 'record)))
  824.         ((looking-at "while\\b\\|with\\b\\|for\\b")
  825.          ;; This could ba a continued expression
  826.          (if (and after-contexpr
  827.               (not (save-excursion (re-search-forward
  828.                         "do\\b" (pascal-get-end-of-line) t))))
  829.          (setq return-struct (list (pascal-lstart-col) 'contexp))
  830.            (setq return-struct (list (current-column) 'whilewith))))
  831.         ((looking-at "procedure\\b\\|function\\b")
  832.          ;; Make sure that this is a function with parameters, and
  833.          ;; that we are actually standing inside the paranthesis.
  834.          (let ((spos (save-excursion
  835.                (search-forward "(" samepos t) (point)))
  836.            (epos (save-excursion
  837.                (search-forward ")" samepos t) (point))))
  838.            (if (and (>= samepos spos) (or (< samepos epos)
  839.                           (> spos epos)))
  840.            (setq return-struct (list 0 'function))
  841.          (setq return-struct (list 0 nil)))))
  842.         ((looking-at "var\\b\\|label\\b\\|const\\b\\|type\\b")
  843.          ;; Are we really in the declaration part?(Check for blank lines)
  844.          (if (< oldpos (point))
  845.          (setq return-struct (list 0 'decl))
  846.            (if (save-excursion
  847.              (not (re-search-forward "^[ \t]*$" oldpos t)))
  848.            (setq return-struct (list 0 'decl))
  849.          (setq return-struct (list 0 nil)))))
  850.         (t
  851.          (setq return-struct (list 0 nil))))
  852.       return-struct)))
  853.  
  854. (defun pascal-lstart-col ()
  855.   "Return the column of the beginning of the first command on the line."
  856.   (save-excursion
  857.     (beginning-of-line)
  858.     (skip-chars-forward ":0-9")
  859.     (skip-chars-forward " \t")
  860.     (current-column)))
  861.  
  862. (defun pascal-indent-parameter-list ()
  863.   "Indent this line as part of a parameter list in a function."
  864.   (let ((indents (pascal-get-highest-indents-in-parameterlist))
  865.     (pos 0))
  866.     (if (not (progn (beginning-of-line)
  867.             (search-forward "(" (pascal-get-end-of-line) t)))
  868.     (progn (beginning-of-line)
  869.              (skip-chars-forward " \t")))
  870.     ;; Indent region in front of var
  871.     (skip-chars-forward " \t")
  872.     (pascal-delete-whitespaces)
  873.     (indent-to (nth 0 indents))
  874.     (if (looking-at "var\\b")
  875.     (forward-char 3))
  876.     ;; Indent parameternames
  877.     (pascal-delete-whitespaces)
  878.     (indent-to (nth 1 indents))
  879.     (if (not (save-excursion (skip-chars-forward " \t") (eolp)))
  880.     (progn
  881.       ;; Indent colon
  882.       (if (search-forward ":" (pascal-get-end-of-line) t)
  883.           (backward-char 1)
  884.         (end-of-line))
  885.       (pascal-delete-whitespaces)
  886.       (indent-to (nth 2 indents))
  887.       ;; Indent after colon
  888.       (if (equal (following-char) ?:)
  889.           (progn
  890.         (forward-char 1)
  891.         (pascal-delete-whitespaces)
  892.         (indent-to (+ 2 (nth 2 indents)))))))))
  893.  
  894. ;; Get the indents to use in a parameterlist.
  895. ;; Returns:
  896. ;; 1. Indent to the beginning of the line.
  897. ;; 2. Indent to the beginning of the parameter names.
  898. ;; 3. Indent to the right colon position."
  899. (defun pascal-get-highest-indents-in-parameterlist ()
  900.   (save-excursion
  901.     (let ((start (progn
  902.            (re-search-backward
  903.             "\\<\\(function\\|procedure\\)\\>" nil t)
  904.            (search-forward "(")
  905.            (current-column)))
  906.       (arglength 0) (vardecl nil) (done nil))
  907.       (while (not (or done (eobp)))
  908.     (beginning-of-line)
  909.     (if (save-excursion
  910.           (re-search-forward "\\<var\\>" (pascal-get-end-of-line) t))
  911.           (setq vardecl t))
  912.     (if (not (re-search-forward ":" (pascal-get-end-of-line) t))
  913.         (setq done t))
  914.     (skip-chars-backward ": \t")
  915.     (setq arglength (max arglength (current-column)))
  916.     (forward-line 1))
  917.       (if vardecl
  918.       (list start (+ start 4) (1+ arglength))
  919.     (list start start (1+ arglength))))))
  920.  
  921. (defun pascal-declindent-middle-of-line (declkey endpos defaultindent)
  922.   "Indent declaration line."
  923.   (let ((decindent 0))
  924.     (if (search-forward declkey endpos t)
  925.     (setq decindent (1- (current-column)))
  926.       (setq decindent defaultindent))
  927.     (goto-char endpos)
  928.     (end-of-line)
  929.     (if (save-excursion (search-backward declkey endpos t))
  930.     (progn (search-backward declkey) (skip-chars-backward " \t"))
  931.       (skip-chars-backward " \t"))
  932.     (pascal-delete-whitespaces)
  933.     (indent-to (max decindent (1+ (current-column))))
  934.     ;; Indent after `declkey'
  935.     (if (looking-at declkey)
  936.     (progn
  937.       (forward-char 1)
  938.       (pascal-delete-whitespaces)
  939.       (indent-to (1+ (current-column)))))))
  940.   
  941. (defun pascal-indent-within-comment (indent)
  942.   "Indent comments and/or indent text within comment."
  943.   (progn
  944.     ;; If we are at the beginning of the line, then we indent this line.
  945.     (if (save-excursion (skip-chars-backward " \t") (bolp))
  946.     (progn
  947.       (beginning-of-line)
  948.       (pascal-delete-whitespaces)
  949.       (indent-to indent))
  950.       ;; Do nothing if we're not in a star comment.
  951.       (if (save-excursion
  952.         (beginning-of-line)
  953.         (skip-chars-forward " \t")
  954.         (looking-at "\\*\\|(\\*"))
  955.       (save-excursion
  956.         (beginning-of-line)
  957.         (search-forward "*")
  958.         (pascal-delete-whitespaces)
  959.         (indent-to (+ (current-column) 2)))))))
  960.  
  961. (defun pascal-find-leading-case-colon ()
  962.   "Return hpos of first colon after the case-of or record line.
  963. If there's no such line, use the place where it ought to be."
  964.   (let ((pos (save-excursion
  965.            (beginning-of-line)
  966.            (skip-chars-forward " \t")
  967.            (point))))
  968.     (save-excursion
  969.       (re-search-backward "\\<\\(case\\|record\\)\\>")
  970.       (forward-line 1)
  971.       (skip-chars-forward " \t")
  972.       (if (not (eq pos (point)))
  973.       (progn
  974.         (search-forward ":" (pascal-get-end-of-line) t)
  975.         (1- (current-column)))
  976.     (+ (current-column) pascal-case-offset)))))
  977.  
  978. (provide 'pascal)
  979.  
  980. ;; pascal.el ends here.
  981.